Prepare the data

# install.packages("psych", repos = "http://personality-project.org/r", type = "source")
# install.packages("psychTools", repos = "http://personality-project.org/r", type = "source")
# install.packages("skimr")

# Load the relevant libraries --------------------------
library(psych)
library(psychTools)
library(tidyverse)
library(janitor)
library(readxl)
library(ggpubr)
library(kableExtra)


# Make sure you're running the most recent version of psych
# sessionInfo()
# Load the functions and data --------------------------
`%nin%` <- Negate(`%in%`)

## Load in the score data 
dryRun_ScoreExportNarrow <- read_csv("/Volumes/fsmresfiles/MSS/Research/Projects/Baby_Toolbox/Data/Combined_Dry_Run_Data/dryRun_ScoreExportNarrow_20230323.csv") %>% 
  janitor::clean_names()

# dim(dryRun_ScoreExportNarrow)
# colnames(dryRun_ScoreExportNarrow)

## Load in the age data 
dryRun_Registration_Age <- read_csv("/Volumes/fsmresfiles/MSS/Research/Projects/Baby_Toolbox/Data/Combined_Dry_Run_Data/dryRun_Registration_Age_20230323.csv") %>% 
  janitor::clean_names()

# dim(dryRun_Registration_Age)
# colnames(dryRun_Registration_Age)

# These are the IDs we care about for analysis
ids_for_analysis <- read_csv("data/2023-03-22T172307_shouldHavecorrected2.csv") %>% 
  rename(PIN = PINsago)

# dim(ids_for_analysis)

analysis_ids <- ids_for_analysis %>% 
  pull(PIN)

Transform the data so that we can use it

# EF Cog -----
# See if anything exploded for EF Cog 16 to 24 months (Touch & Gaze)
ef_names <- c("ExecutiveFunction", "TouchTutorial", #"MVR",
              "MemTaskLearn", "VDRTouch", "MemTaskTest")

ef_cog_df <- dryRun_ScoreExportNarrow %>% 
  filter(test_name %in% ef_names) %>% 
  filter(pin %in% analysis_ids) 

# ef_cog_df %>% 
#   count(test_name, instrument_title)
# 
# ef_cog_df %>% 
#   count(instrument_title, key)
# 
# ef_cog_df %>% 
#   count(test_name, key)

ef_cog_age_df <- full_join(ef_cog_df, dryRun_Registration_Age, 
          by = c("pin", "pid", "registration_id", "assessment_name"),
          multiple = "all")

Pivot the table

ef_cog_pivot <- ef_cog_age_df %>% 
  filter(!is.na(instrument_title)) %>% 
  filter(key %nin% c("Language", "InstrumentSandSReason", 
                      "InstrumentRCReasonOther", "InstrumentBreakoff",
                     "InstrumentStatus2")) %>% 
  pivot_wider(id_cols = c(pin, pid, registration_id,
                          assessment_name, #instrument_title,
                          total_age_in_months),
              names_from = c("test_name", "key"),
              values_from = "value") %>% 
  select(pin:total_age_in_months, starts_with("TouchTutorial_"),
         starts_with("MemTaskLearn_"), starts_with("MemTaskTest_"),
         starts_with("VDRTouch_"), starts_with("ExecutiveFunction_"),
         everything()) %>% 
  type_convert()

Understanding the Data

How many children took each task?

ef_cog_age_df %>% 
    filter(!is.na(test_name)) %>% 
    select(pin, test_name, total_age_in_months) %>% 
    unique() %>% 
  group_by(test_name) %>% 
  mutate(min_age = min(total_age_in_months),
         max_age = max(total_age_in_months)) %>% 
  ungroup() %>% 
  count(test_name, min_age, max_age) %>% 
  rename("Test Name" = test_name,
         "Min Age" = min_age,
         "Max Age" = max_age)%>% 
kbl(caption = "Number of participants and age range by task") %>% 
  kable_styling()
Number of participants and age range by task
Test Name Min Age Max Age n
ExecutiveFunction 6 21 35
MemTaskLearn 16 48 42
MemTaskTest 16 48 42
TouchTutorial 16 48 42
VDRTouch 16 48 42 
ef_cog_age_df %>% 
    filter(total_age_in_months < 25) %>% 
  filter(!is.na(test_name)) %>% 
  select(pin, test_name, total_age_in_months) %>% 
  unique() %>% 
  count(test_name) %>% 
  rename("Test Name" = test_name) %>% 
kbl(caption = "Number of participants by task (<25 months)") %>% 
  kable_styling()
Number of participants by task (<25 months)
Test Name n
ExecutiveFunction 35
MemTaskLearn 8
MemTaskTest 8
TouchTutorial 8
VDRTouch 8

Who got through touch?

ef_cog_age_df %>% 
    filter(total_age_in_months < 25) %>% 
  filter(key == "InstrumentBreakoff") %>% 
  count(test_name, value) %>% 
  filter(value == 1) %>% 
  select(-c(value)) %>% 
  rename("Test Name" = test_name) %>% 
kbl(caption = "Whose instrument’s administration was interrupted? (<25 months)") %>% 
  kable_styling()
Whose instrument’s administration was interrupted? (<25 months)
Test Name n
ExecutiveFunction 7
MemTaskLearn 7
MemTaskTest 8
TouchTutorial 4
VDRTouch 6 
ef_cog_age_df %>% 
    filter(total_age_in_months < 25) %>% 
  filter(key == "InstrumentStatus2") %>% 
  count(test_name, value) %>% 
  filter(value == 4) %>% 
  select(-c(value)) %>% 
  rename("Test Name" = test_name) %>% 
kbl(caption = "Who did not complete the assessment? (<25 months)") %>% 
  kable_styling()
Who did not complete the assessment? (<25 months)
Test Name n
ExecutiveFunction 7
MemTaskLearn 7
MemTaskTest 8
TouchTutorial 4
VDRTouch 6 
ef_cog_age_df %>% 
    filter(total_age_in_months < 25) %>% 
  filter(key == "InstrumentRCReasonOther") %>% 
  count(test_name, value) %>% 
  filter(test_name != "ExecutiveFunction")  %>% 
  rename("Test Name" = test_name) %>% 
kbl(caption = "Reason for interuption on touch tasks (<25 months)") %>% 
  kable_styling()
Reason for interuption on touch tasks (<25 months)
Test Name value n
MemTaskLearn Delay ended test 2
MemTaskLearn Participant accidently used admin gesture, test will not resume. 1
MemTaskLearn Participant used admin waver 1
MemTaskTest Memory Task Test started before minimum time 1
MemTaskTest Memory Task Test started before minimum time | Delay ended test 1
MemTaskTest Memory Task Test started before minimum time | Delayed | Repeated Memory Task Test 2
MemTaskTest Skipped test 4
TouchTutorial App interruption | Nbt touch tutorial not functioning? 1
VDRTouch App interruption | I am trying to keep her engaged but she is having a massive tantrum 1
VDRTouch Delayed | Delayed 1

Correlations

Touch

ef_cog_pivot %>% 
  select(total_age_in_months, starts_with("TouchTutorial_"), starts_with("MemTaskLearn_"), starts_with("MemTaskTest_"), 
         starts_with("VDRTouch_")) %>% 
  select(-c(ends_with("_ItemCount"))) %>% 
  cor(., use = "pairwise", method = "spearman") %>% 
  round(., 3) %>% 
  cor.plot(., xlas = 3)

Touch Tutorial

ef_cog_pivot %>% 
  select(total_age_in_months, starts_with("TouchTutorial_")) %>% 
  cor(., use = "pairwise", method = "spearman") %>% 
  round(., 3) %>% 
kbl(caption = "Correlations of Age and Touch Tutorial") %>% 
  kable_styling()
Correlations of Age and Touch Tutorial
total_age_in_months TouchTutorial_ItemCount TouchTutorial_RawScore
total_age_in_months 1.000 0.068 0.308
TouchTutorial_ItemCount 0.068 1.000 -0.646
TouchTutorial_RawScore 0.308 -0.646 1.000

Memory Task (Learning)

ef_cog_pivot %>% 
  select(total_age_in_months,  starts_with("MemTaskLearn_")) %>% 
  cor(., use = "pairwise", method = "spearman") %>% 
  round(., 3) %>% 
kbl(caption = "Correlations of Age and Memorty Task (Learning)") %>% 
  kable_styling()
Correlations of Age and Memorty Task (Learning)
total_age_in_months MemTaskLearn_ItemCount MemTaskLearn_RawScore
total_age_in_months 1.000 0.564 0.422
MemTaskLearn_ItemCount 0.564 1.000 NA
MemTaskLearn_RawScore 0.422 NA 1.000

Memory Task (Testing)

ef_cog_pivot %>% 
  select(total_age_in_months,  starts_with("MemTaskTest_")) %>% 
  cor(., use = "pairwise", method = "spearman") %>% 
  round(., 3) %>% 
kbl(caption = "Correlations of Age and Memorty Task (Test)") %>% 
  kable_styling()
Correlations of Age and Memorty Task (Test)
total_age_in_months MemTaskTest_ItemCount MemTaskTest_RawScore
total_age_in_months 1.000 0.41 -0.048
MemTaskTest_ItemCount 0.410 1.00 NA
MemTaskTest_RawScore -0.048 NA 1.000

VDR

ef_cog_pivot %>% 
  select(total_age_in_months,  
         starts_with("VDRTouch_")) %>% 
  cor(., use = "pairwise", method = "spearman") %>% 
  round(., 3) %>% 
kbl(caption = "Correlations of Age and VDR") %>% 
  kable_styling()
Correlations of Age and VDR
total_age_in_months VDRTouch_VDRTouchAccuracy VDRTouch_VDRTouchReactionCorrect VDRTouch_VDRTouchReactionIncorrect VDRTouch_ItemCount
total_age_in_months 1.000 0.341 -0.178 -0.053 0.561
VDRTouch_VDRTouchAccuracy 0.341 1.000 -0.284 -0.252 NA
VDRTouch_VDRTouchReactionCorrect -0.178 -0.284 1.000 0.385 NA
VDRTouch_VDRTouchReactionIncorrect -0.053 -0.252 0.385 1.000 NA
VDRTouch_ItemCount 0.561 NA NA NA 1.000

Gaze

ef_cog_pivot %>% 
  select(total_age_in_months, starts_with("ExecutiveFunction_")) %>% 
    select(-c(ends_with("_ItemCount"))) %>% 
  rename_with(stringr::str_replace, 
              pattern = "ExecutiveFunction\\_", replacement = "", 
              matches("ExecutiveFunction\\_")) %>% 
  cor(., use = "pairwise", method = "spearman") %>% 
  round(., 3) %>% 
  cor.plot(., xlas = 3)

ef_cog_pivot %>% 
  select(total_age_in_months, starts_with("ExecutiveFunction_")) %>% 
  rename_with(stringr::str_replace, 
              pattern = "ExecutiveFunction\\_", replacement = "", 
              matches("ExecutiveFunction\\_")) %>% 
  cor(., use = "pairwise", method = "spearman") %>% 
  round(., 3) %>% 
kbl(caption = "Correlations of Age and Gaze") %>% 
  kable_styling()
Correlations of Age and Gaze
total_age_in_months RawScore FamiliarizationRound1 FamiliarizationRound2 FamiliarizationMean AverageNovelty1Scores AverageNovelty2Scores AverageNoveltyDelayedRecall AverageNoveltyImmediatePreference VDRCorrectRound1 VDRCorrectRound2 VDRCorrectBothRounds ItemCount
total_age_in_months 1.000 0.176 0.095 -0.184 -0.027 0.157 0.208 0.338 0.262 -0.328 -0.420 -0.551 -0.117
RawScore 0.176 1.000 -0.190 -0.117 -0.185 0.425 0.629 0.580 0.680 -0.544 -0.494 -0.498 -0.281
FamiliarizationRound1 0.095 -0.190 1.000 0.070 0.548 -0.176 -0.183 -0.272 -0.178 0.081 0.352 0.291 0.094
FamiliarizationRound2 -0.184 -0.117 0.070 1.000 0.868 0.198 -0.653 -0.412 -0.393 0.200 0.405 0.259 -0.136
FamiliarizationMean -0.027 -0.185 0.548 0.868 1.000 0.113 -0.529 -0.435 -0.322 0.232 0.476 0.354 0.053
AverageNovelty1Scores 0.157 0.425 -0.176 0.198 0.113 1.000 0.364 0.401 0.751 -0.298 -0.198 -0.208 -0.206
AverageNovelty2Scores 0.208 0.629 -0.183 -0.653 -0.529 0.364 1.000 0.576 0.858 -0.440 -0.485 -0.438 -0.216
AverageNoveltyDelayedRecall 0.338 0.580 -0.272 -0.412 -0.435 0.401 0.576 1.000 0.612 -0.354 -0.736 -0.556 -0.372
AverageNoveltyImmediatePreference 0.262 0.680 -0.178 -0.393 -0.322 0.751 0.858 0.612 1.000 -0.543 -0.438 -0.469 -0.283
VDRCorrectRound1 -0.328 -0.544 0.081 0.200 0.232 -0.298 -0.440 -0.354 -0.543 1.000 0.574 0.854 0.215
VDRCorrectRound2 -0.420 -0.494 0.352 0.405 0.476 -0.198 -0.485 -0.736 -0.438 0.574 1.000 0.836 0.124
VDRCorrectBothRounds -0.551 -0.498 0.291 0.259 0.354 -0.208 -0.438 -0.556 -0.469 0.854 0.836 1.000 0.231
ItemCount -0.117 -0.281 0.094 -0.136 0.053 -0.206 -0.216 -0.372 -0.283 0.215 0.124 0.231 1.000

Linear Plots (All Ages)

Touch

lapply(
  names(ef_cog_pivot)[c(7, 9, 11:14)], 
  function(n) 
    ggplot(data = ef_cog_pivot, aes_string(x="total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(method = "lm", se = FALSE) +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw() +
    scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

Gaze

lapply(
  names(ef_cog_pivot)[16:26], 
  function(n) 
    ggplot(data = ef_cog_pivot, aes_string(x="total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(method = "lm", se = FALSE) +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw() +
    scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

## 
## [[7]]

## 
## [[8]]

## 
## [[9]]

## 
## [[10]]

## 
## [[11]]

Non-Linear Plots (All Ages)

Touch

lapply(
  names(ef_cog_pivot)[c(7, 9, 11:14)], 
  function(n) 
    ggplot(data = ef_cog_pivot, aes_string(x = "total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(se = FALSE, color = "red") +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw() +
    scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

Gaze

lapply(
  names(ef_cog_pivot)[16:26], 
  function(n) 
    ggplot(data = ef_cog_pivot, aes_string(x = "total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(se = FALSE, color = "red") +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw() +
    scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

## 
## [[7]]

## 
## [[8]]

## 
## [[9]]

## 
## [[10]]

## 
## [[11]]

Old plots (7 to 20 month olds)

Old Memory Graph

Old VDR Graph

Linear Plots (16 to 21 month olds)

limitedAge_ef_cog_pivot <- ef_cog_pivot %>% 
  filter(between(total_age_in_months, 16, 21))

Touch

lapply(
  names(limitedAge_ef_cog_pivot)[c(7, 9, 11:14)], 
  function(n) 
    ggplot(data = limitedAge_ef_cog_pivot, aes_string(x="total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(method = "lm", se = FALSE) +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw()
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

Gaze

lapply(
  names(limitedAge_ef_cog_pivot)[16:26], 
  function(n) 
    ggplot(data = limitedAge_ef_cog_pivot, aes_string(x="total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(method = "lm", se = FALSE) +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw()
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

## 
## [[7]]

## 
## [[8]]

## 
## [[9]]

## 
## [[10]]

## 
## [[11]]

Non-Linear Plots (16 to 21 month olds)

Touch

lapply(
  names(limitedAge_ef_cog_pivot)[c(7, 9, 11:14)], 
  function(n) 
    ggplot(data = limitedAge_ef_cog_pivot, aes_string(x = "total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(se = FALSE, color = "red") +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw()
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

Gaze

lapply(
  names(limitedAge_ef_cog_pivot)[16:26], 
  function(n) 
    ggplot(data = limitedAge_ef_cog_pivot, aes_string(x = "total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(se = FALSE, color = "red") +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw()
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

## 
## [[7]]

## 
## [[8]]

## 
## [[9]]

## 
## [[10]]

## 
## [[11]]

Familiarization without outliers

Remove the outlier

ef_cog_pivot_2 <- ef_cog_pivot %>% 
  filter(ExecutiveFunction_FamiliarizationRound2 < 6000)

limitedAge_ef_cog_pivot2 <- limitedAge_ef_cog_pivot %>% 
  filter(ExecutiveFunction_FamiliarizationRound2 < 6000)

All ages

Correlations

ef_cog_pivot_2 %>% 
  select(total_age_in_months, starts_with("ExecutiveFunction_")) %>% 
  rename_with(stringr::str_replace, 
              pattern = "ExecutiveFunction\\_", replacement = "", 
              matches("ExecutiveFunction\\_")) %>% 
  select(total_age_in_months, starts_with("Familiarization")) %>% 
  cor(., use = "pairwise", method = "spearman") %>% 
  round(., 3) %>% 
  cor.plot(., xlas = 3)

Linear Plots

lapply(
  names(ef_cog_pivot_2)[17:19], 
  function(n) 
    ggplot(data = ef_cog_pivot_2, aes_string(x="total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(method = "lm", se = FALSE) +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw() +
    scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

Non- Linear Plots

lapply(
  names(ef_cog_pivot_2)[17:19], 
  function(n) 
    ggplot(data = ef_cog_pivot_2, aes_string(x="total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(color = "red", se = FALSE) +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw() +
    scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

16 to 21 month olds

Correlations

limitedAge_ef_cog_pivot2 %>% 
  select(total_age_in_months, starts_with("ExecutiveFunction_")) %>% 
  rename_with(stringr::str_replace, 
              pattern = "ExecutiveFunction\\_", replacement = "", 
              matches("ExecutiveFunction\\_")) %>% 
  select(total_age_in_months, starts_with("Familiarization")) %>% 
  cor(., use = "pairwise", method = "spearman") %>% 
  round(., 3) %>% 
  cor.plot(., xlas = 3)

Linear Plots

lapply(
  names(limitedAge_ef_cog_pivot2)[17:19], 
  function(n) 
    ggplot(data = limitedAge_ef_cog_pivot2, aes_string(x="total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(method = "lm", se = FALSE) +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw()
)
## [[1]]

## 
## [[2]]

## 
## [[3]]

Non- Linear Plots

lapply(
  names(limitedAge_ef_cog_pivot2)[17:19], 
  function(n) 
    ggplot(data = limitedAge_ef_cog_pivot2, aes_string(x="total_age_in_months", y = n)) + 
    geom_point() + 
    geom_smooth(color = "red", se = FALSE) +
    stat_cor(method = "spearman",
             aes(label = ..r.label..)) +
     theme_bw()
)
## [[1]]

## 
## [[2]]

## 
## [[3]]